perm filename CLIPER.SAI[1,BGB] blob
sn#001266 filedate 1972-10-22 generic text, type T, neo UTF8
00100 ENTRY CLIPER;
00200 BEGIN "CLIPPER"
00300 DEFINE α="COMMENT";
00350 α CLIPER ARGUMENTS;
00400 EXTERNAL INTEGER XL,YL,XH,YH; α THE WINDOW;
00450 EXTERNAL REAL SX,SY,SZ; α THE SCALES;
00475 EXTERNAL REAL FOCAL;
00500 EXTERNAL REAL X1,Y1,Z1,X2,Y2,Z2; α THE LINE SEGMENT;
00600 EXTERNAL INTEGER XX1,YY1,XX2,YY2; α THE CLIPPED LINE SEGMENT;
00700 INTEGER QNE,QNW,QSW,QSE;
00900 α CLIPER RETURNS:
01000 0 - BOTH ENDS WITHIN.
01100 1 - END1 WITHIN.
01200 2 - END2 WITHIN.
01300 3 - EDGE HITS BUT BOTH ENDS OUT.
01400 4 - COMPLETE MISS - WINDOW IS EXTERIOR WRT THE LINE SEGMENT.
01500 5 - COMPLETE MISS - WINDOW IS NOT EXTERIOR;
01600 α THE CLIPER;
01700 INTERNAL INTEGER PROCEDURE CLIPER;
01800 BEGIN
02000 INTEGER A,B,C,AXL,AXH,BYL,BYH,IN1,IN2;
02100 LABEL NOSHOW;
02200 α Z CLIPPING IF NECESSARY;
02300 IF Z1>0 ∧ Z2>0 THEN RETURN(4); α INTERIOR SIDED OUTSIDER;
02400 IF Z2>0 THEN
02500 BEGIN
02550 REAL X,Y,Z,DZ;
02600 Z ← SZ/Z1;
02700 Y ← Y1*Z/SY;
02800 X ← X1*Z/SX;
02900 DZ ← (FOCAL+Z)/(FOCAL+Z-Z2);
03000 X2 ← (X2-X)*DZ + X;
03100 Y2 ← (Y2-Y)*DZ + Y;
03200 X2 ← -X2*SX/FOCAL;
03300 Y2 ← -Y2*SY/FOCAL;
03400 END;
03500 IF Z1>0 THEN
03600 BEGIN
03650 REAL X,Y,Z,DZ;
03700 Z ← SZ/Z2;
03800 Y ← Y2*Z/SY;
03900 X ← X2*Z/SX;
04000 DZ ← (FOCAL+Z)/(FOCAL+Z-Z1);
04100 X1 ← (X1-X)*DZ + X;
04200 Y1 ← (Y1-Y)*DZ + Y;
04300 X1 ← -X1*SX/FOCAL;
04400 Y1 ← -Y1*SY/FOCAL;
04500 END;
00100 α EASY INSIDERS;
00200 IN1 ← XL≤X1 ∧ X1≤XH ∧ YL≤Y1 ∧ Y1≤YH;
00300 IN2 ← XL≤X2 ∧ X2≤XH ∧ YL≤Y2 ∧ Y2≤YH;
00400 IF IN1 ∧ IN2 THEN
00500 BEGIN
00600 XX1 ← X1;
00700 YY1 ← Y1;
00800 XX2 ← X2;
00900 YY2 ← Y2;
01000 RETURN(0); α BOTH WITHIN;
01100 END;
01200 α LINE COEFFICIENTS, INTERIOR TO THE LEFT IS POSITIVE;
01300 A ← Y1 - Y2;
01400 B ← X2 - X1;
01500 C ← X1*Y2 - X2*Y1;
01600 α PARTIAL PRODUCTS;
01700 AXL ← A*XL;
01800 AXH ← A*XH;
01900 BYL ← B*YL;
02000 BYH ← B*YH;
02100 α CORNER Q'S;
02200 QNE ← AXH + BYH + C;
02300 QNW ← AXL + BYH + C;
02400 QSW ← AXL + BYL + C;
02500 QSE ← AXH + BYL + C;
02600 α EASY OUTSIDERS;
02700 IF X1>XH ∧ X2>XH ∨
02800 X1<XL ∧ X2<XL ∨
02900 Y1<YL ∧ Y2<YL ∨
03000 Y1>YH ∧ Y2>YH THEN GO NOSHOW;
00100 α SIDE CROSSINGS;
00200 DEFINE N? = "QNE⊗QNW<0";
00300 DEFINE S? = "QSE⊗QSW<0";
00400 DEFINE E? = "QNE⊗QSE<0";
00500 DEFINE W? = "QNW⊗QSW<0";
00600
00700 DEFINE EAST1 = "BEGIN XX1 ← XH; YY1 ← -(AXH + C)/B END";
00800 DEFINE WEST1 = "BEGIN XX1 ← XL; YY1 ← -(AXL + C)/B END";
00900 DEFINE NORTH1 = "BEGIN XX1 ← -(BYH + C)/A; YY1 ← YH END";
01000 DEFINE SOUTH1 = "BEGIN XX1 ← -(BYL + C)/A; YY1 ← YL END";
01100
01200 DEFINE EAST2 = "BEGIN XX2 ← XH; YY2 ← -(AXH + C)/B END";
01300 DEFINE WEST2 = "BEGIN XX2 ← XL; YY2 ← -(AXL + C)/B END";
01400 DEFINE NORTH2 = "BEGIN XX2 ← -(BYH + C)/A; YY2 ← YH END";
01500 DEFINE SOUTH2 = "BEGIN XX2 ← -(BYL + C)/A; YY2 ← YL END";
00100 α SINGLE CROSSER END1 WITHIN;
00200 IF IN1 THEN
00300 BEGIN
00400 IF E? THEN
00500 IF X2>XH THEN EAST2 ELSE
00600 IF N? THEN NORTH2 ELSE
00700 IF S? THEN SOUTH2 ELSE WEST2 ELSE
00800 IF N? THEN
00900 IF Y2>YH THEN NORTH2 ELSE
01000 IF S? THEN SOUTH2 ELSE WEST2 ELSE
01100 IF XL>X2 THEN WEST2 ELSE SOUTH2;
01200 XX1 ← X1;
01300 YY1 ← Y1;
01400 RETURN(1);
01500 END ELSE
01600 α SINGLE CROSSER END2 WITHIN;
01700 IF IN2 THEN
01800 BEGIN
01900 IF E? THEN
02000 IF X1>XH THEN EAST1 ELSE
02100 IF N? THEN NORTH1 ELSE
02200 IF S? THEN SOUTH1 ELSE WEST1 ELSE
02300 IF N? THEN
02400 IF Y1>YH THEN NORTH1 ELSE
02500 IF S? THEN SOUTH1 ELSE WEST1 ELSE
02600 IF XL>X1 THEN WEST1 ELSE SOUTH1;
02700 XX2 ← X2;
02800 YY2 ← Y2;
02900 RETURN(2);
03000 END ELSE
03100 α DOUBLE CROSSER;
03200 IF E? THEN
03300 BEGIN
03400 EAST1;
03500 IF N? THEN NORTH2 ELSE
03600 IF S? THEN SOUTH2 ELSE WEST2;
03700 END ELSE
03800 IF N? THEN
03900 BEGIN
04000 NORTH1;
04100 IF S? THEN SOUTH2 ELSE WEST2;
04200 END ELSE
04300 IF W? THEN
04400 BEGIN
04500 WEST1;
04600 SOUTH2;
04700 END ELSE GO NOSHOW;
04800 RETURN(3);
04900 NOSHOW: IF QNE<0 ∧ QNW<0 ∧ QSW<0 ∧ QSE<0 THEN RETURN(4) α PURELY EXTERIOR;
05000 ELSE RETURN(5); α NO EXTERIOR;
05100 END; END